home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / utility / 71 / utl / gem4arc1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-11-21  |  14.5 KB  |  357 lines
  1. {$S40,D-,P-,R-,T-}
  2. PROGRAM gem4arc1 ;
  3. { GEM menu to run the ARC.TTP program.       Written in OSS Personal Pascal  }
  4. { All functions are supported except for redirection                         }
  5. { Works in med and high rez. ARC.TTP must be in current directory            }
  6. { Portions of this product are Copyright (c) 1986 OSS and CCD                }
  7. { Used by Permission of OSS                                                  }
  8. { Written by William R. Good   OCT 1986.           Released to public domain }
  9.  
  10.   CONST
  11.     {$I GEMCONST.PAS}
  12.  
  13.   TYPE
  14.     {$I gemtype.pas}
  15.  
  16.      PREC = PACKED RECORD
  17.                curpath : PACKED ARRAY [ 1..64 ] of Char ;
  18.             END ;
  19.  
  20.  
  21.   VAR
  22.     temp1, temp2, temp3,
  23.     main_selection, sec_selection,
  24.     arc_name, path, tempname : string ;
  25.     search_mask : string[255] ;
  26.     test, selection, flag : boolean ;
  27.  
  28.   {$I gemsubs}
  29.  
  30. { Start GEMDOS calls                                                  }
  31.  
  32. FUNCTION cur_drive : integer ; { 0 = A  1 = B }
  33.    GEMDOS ( $19 ) ;
  34.  
  35. PROCEDURE get_dir( VAR buffer : PREC ; drive : integer ) ;
  36.    GEMDOS ( $47 ) ;
  37.  
  38. { End GEMDOS calls                                                    }
  39.  
  40. { Start XBIOS calls                                                   }
  41.  
  42. FUNCTION getrez : integer ; { 0 = low  1 = med  2 = high }
  43.    XBIOS ( $4 ) ;
  44.  
  45. { End XBIOS calls                                                     }
  46.  
  47. PROCEDURE find_rez ;
  48.    { check current rez }
  49.  
  50.    VAR
  51.        button : integer ;
  52.        alerttext : string[255] ;
  53.        part1, part2 : string ;
  54.    BEGIN
  55.       if getrez < 1 then
  56.          Begin
  57.             part1 := '[3][GEM4ARC1 runs in med or high |' ;
  58.             part2 := 'rez. Please change rez][  SORRY  ]' ;
  59.             alerttext := Concat ( part1, part2 ) ;
  60.             button := Do_Alert(alerttext,1) ;
  61.             halt ;
  62.          END ;
  63.    END ; {find_rez}
  64.  
  65. PROCEDURE get_pathname ( VAR fullpath : string ) ;
  66.  
  67.    VAR
  68.  
  69.       temp_num, drive_num : integer ;
  70.       place : integer ;
  71.       drive_ltr : char ;
  72.       testpath : string ;
  73.       temppath : PREC ;
  74.  
  75.    BEGIN
  76.       drive_num := cur_drive ;
  77.       temp_num := drive_num + 65 ;
  78.       drive_ltr := chr( temp_num ) ;
  79.       drive_num := drive_num + 1 ;
  80.       get_dir( temppath, drive_num ) ;
  81.       with temppath DO
  82.          BEGIN
  83.             place := 1 ;
  84.             testpath := '' ;
  85.  
  86.             WHILE ( place <=64 ) AND ( curpath[place] <> chr(0)) DO
  87.                BEGIN
  88.                   testpath := concat(testpath, curpath[place]) ;
  89.                   place := place + 1 ;
  90.                END ;
  91.             fullpath := concat( drive_ltr, ':', testpath, '\' ) ;
  92.          END ;
  93.    END ; {get_pathname}
  94.  
  95. PROCEDURE make_main( mdialog : dialog_ptr ; VAR madd : integer ;
  96.                    VAR mmove : integer ; VAR mupdate : integer ;
  97.                    VAR mfreshen : integer ; VAR mextract : integer ;
  98.                    VAR mdelete : integer ; VAR mrun : integer ;
  99.                    VAR mcopy : integer ; VAR mlist : integer ;
  100.                    VAR mverbose : integer ; VAR mtest : integer ;
  101.                    VAR mconvert : integer ) ;
  102.  
  103.   BEGIN
  104.         { main file options                                   }
  105.  
  106.         madd := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  107.                           1, 9, 10, 1, 1, $1180 ) ;
  108.         Set_DText( mdialog, madd, 'ADD', System_Font, TE_Center ) ;
  109.  
  110.         mmove := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  111.                           12, 9, 10, 1, 1, $1180 ) ;
  112.         Set_DText( mdialog, mmove, 'MOVE', System_Font, TE_Center ) ;
  113.  
  114.         mupdate := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  115.                           23, 9, 10, 1, 1, $1180 ) ;
  116.         Set_DText( mdialog, mupdate, 'UPDATE', System_Font, TE_Center ) ;
  117.  
  118.         mfreshen := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  119.                           1, 11, 10, 1, 1, $1180 ) ;
  120.         Set_DText( mdialog, mfreshen, 'FRESHEN', System_Font, TE_Center ) ;
  121.  
  122.         mextract := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  123.                           12, 11, 10, 1, 1, $1180 ) ;
  124.         Set_DText( mdialog, mextract, 'EXTRACT', System_Font, TE_Center ) ;
  125.  
  126.         mdelete := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  127.                           23, 11, 10, 1, 1, $1180 ) ;
  128.         Set_DText( mdialog, mdelete, 'DELETE', System_Font, TE_Center ) ;
  129.  
  130.         mrun := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  131.                           1, 13, 10, 1, 1, $1180 ) ;
  132.         Set_DText( mdialog, mrun, 'RUN', System_Font, TE_Center ) ;
  133.  
  134.         mcopy := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  135.                           12, 13, 10, 1, 1, $1180 ) ;
  136.         Set_DText( mdialog, mcopy, 'COPY', System_Font, TE_Center ) ;
  137.  
  138.         mlist := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  139.                           23, 13, 10, 1, 1, $1180 ) ;
  140.         Set_DText( mdialog, mlist, 'LIST', System_Font, TE_Center ) ;
  141.  
  142.         mverbose := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  143.                           1, 15, 10, 1, 1, $1180 ) ;
  144.         Set_DText( mdialog, mverbose, 'VERBOSE', System_Font, TE_Center ) ;
  145.         Obj_SetState( mdialog, mverbose, selected, False ) ;
  146.  
  147.         mtest := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  148.                           12, 15, 10, 1, 1, $1180 ) ;
  149.         Set_DText( mdialog, mtest, 'TEST', System_Font, TE_Center ) ;
  150.  
  151.         mconvert := Add_DItem( mdialog, G_Button,selectable|Radio_btn,
  152.                           23, 15, 10, 1, 1, $1180 ) ;
  153.         Set_DText( mdialog, mconvert, 'CONVERT', System_Font, TE_Center ) ;
  154.   END ; { make_main }
  155.  
  156. PROCEDURE make_second( VAR sdialog : dialog_ptr ; VAR shold : integer ;
  157.                        VAR sretain : integer ; VAR ssuppr_comp : integer ;
  158.                        VAR ssuppr_warn : integer ; VAR ssuppr_not : integer ;
  159.                        VAR sencript : integer ) ;
  160.  
  161.    BEGIN
  162.         { secondary options                                                   }
  163.  
  164.         shold := Add_DItem( sdialog, G_Button,selectable,
  165.                           38, 9, 15, 1, 2, $1180 ) ;
  166.         Set_DText( sdialog, shold, 'HOLD SCREEN', System_Font, TE_Center ) ;
  167.         Obj_SetState( sdialog, shold, selected, False ) ;
  168.  
  169.         sretain := Add_DItem( sdialog, G_Button,selectable,
  170.                           54, 9, 15, 1, 2, $1180 ) ;
  171.         Set_DText(sdialog, sretain, 'RETAIN BACKUP', System_Font, TE_Center ) ;
  172.  
  173.         ssuppr_comp := Add_DItem( sdialog, G_Button,selectable,
  174.                           38, 11, 31, 1, 2, $1180 ) ;
  175.         Set_DText( sdialog, ssuppr_comp,
  176.                   'SUPPRESS COMPRESSION', System_Font, TE_Center ) ;
  177.  
  178.         ssuppr_warn := Add_DItem( sdialog, G_Button,selectable,
  179.                           38, 13, 31, 1, 2, $1180 ) ;
  180.         Set_DText( sdialog, ssuppr_warn,
  181.                    'SUPPRESS WARNING MESSAGES', System_Font, TE_Center ) ;
  182.  
  183.         ssuppr_not := Add_DItem( sdialog, G_Button,selectable,
  184.                           38, 15, 31, 1, 2, $1180 ) ;
  185.         Set_DText( sdialog, ssuppr_not,
  186.                    'SUPPRESS NOTES', System_Font, TE_Center ) ;
  187.  
  188.         sencript := Add_DItem( sdialog, G_Button,selectable,
  189.                           38, 17, 31, 1, 2, $1180 ) ;
  190.         Set_DText( sdialog, sencript,
  191.                    'ENCRIPT / DECRIPT', System_Font, TE_Center ) ;
  192.    END ; { make_second }
  193.  
  194.  PROCEDURE make_box( VAR doflag : boolean ; VAR main_opt : string ;
  195.                      VAR second_opt : string ; VAR mask : string ) ;
  196.   VAR
  197.     dialog : Dialog_Ptr ;
  198.     button, cancel_btn, ok_btn, boxtitle,
  199.     prompt1_item, prompt2_item, prompt3_item, prompt4_item, prompt5_item,
  200.     prompt6_item, encr_item, mask_item : integer ;
  201.     add, move, update, freshen, extract, delete : integer ;
  202.     run, copy, list, verbose, test, convert : integer ;
  203.     hold, retain, suppr_comp, suppr_warn, suppr_not, encript : integer ;
  204.     key : string ;
  205.     maskline, encrline : string [255] ;
  206.       BEGIN
  207.         dialog := New_Dialog( 30, 0, 0, 70, 20 ) ;
  208.  
  209.         boxtitle := Add_DItem( dialog, G_String, None, 1, 1, 0, 0, 0, 0 ) ;
  210.         Set_DText( dialog, boxtitle,
  211.         'GEM4ARC1 by William R. Good Released to Public Domain. ARC.TTP must',
  212.                                       System_Font, TE_Left ) ;
  213.  
  214.         prompt1_item := Add_DItem( dialog, G_String, None, 1, 2, 0, 0, 0, 0 ) ;
  215.         Set_DText( dialog, prompt1_item,
  216.         'be in current directory. Portions of this product are Copyright (c)',
  217.                         System_Font, TE_Left ) ;
  218.  
  219.         prompt2_item := Add_DItem( dialog, G_String, None, 1, 3, 0, 0, 0, 0 ) ;
  220.         Set_DText( dialog, prompt2_item,
  221.         '1986 OSS and CCD. Used by permision of OSS.',
  222.                         System_Font, TE_Left ) ;
  223.  
  224.         prompt3_item := Add_DItem( dialog, G_String, None, 1, 4, 0, 1, 0, 0 ) ;
  225.         Set_DText( dialog, prompt3_item,
  226.                        'Make Selections then enter search mask :',
  227.                         System_Font, TE_Left ) ;
  228.  
  229.         mask_item := Add_DItem( dialog, G_FText, None, 42, 4, 12,
  230.                         1, 0, $1180 );
  231.  
  232.         Set_DEdit( dialog, mask_item, '____________', 'PPPPPPPPPPPP',
  233.                            '*.*', System_Font, TE_Center ) ;
  234.  
  235.         prompt4_item := Add_DItem( dialog, G_String, None, 1, 6, 0, 1, 0, 0 ) ;
  236.         Set_DText( dialog, prompt4_item,
  237.                        'If used enter encript key word :',
  238.                         System_Font, TE_Left ) ;
  239.  
  240.         encr_item := Add_DItem( dialog, G_FText, None, 34, 6, 12,
  241.                         1, 0, $1180 );
  242.  
  243.         Set_DEdit( dialog, encr_item, '____________', 'nnnnnnnnnnnn',
  244.                            '', System_Font, TE_Center ) ;
  245.  
  246.         prompt5_item := Add_DItem( dialog, G_String, None, 8, 8, 0, 0, 0, 0 ) ;
  247.         Set_DText( dialog, prompt5_item,
  248.                'MAIN FILE OPTIONS                     SECONDARY OPTIONS',
  249.                         System_Font, TE_Left ) ;
  250.  
  251.         make_main( dialog, add, move, update, freshen, extract, delete,
  252.                  run, copy, list, verbose, test, convert ) ;
  253.  
  254.         make_second( dialog, hold, retain, suppr_comp, suppr_warn,
  255.                    suppr_not, encript ) ;
  256.  
  257.         cancel_btn := Add_DItem( dialog, G_Button, Selectable|Touch_Exit,
  258.                         1, 17, 10, 2, 1, $1180 ) ;
  259.         Set_DText( dialog, cancel_btn, 'Cancel', System_Font, TE_Center ) ;
  260.         ok_btn := Add_DItem( dialog, G_Button, Selectable|Default|Touch_Exit,
  261.                         12, 17, 10, 2, 1, $1180 ) ;
  262.         Set_DText( dialog, ok_btn, 'OK', System_Font, TE_Center ) ;
  263.  
  264.         Center_Dialog( dialog ) ;
  265.  
  266.         button := Do_Dialog( dialog, mask_item ) ;
  267.  
  268.         if Obj_State ( dialog, ok_btn) & Selected <> 0 then
  269.            begin
  270.               maskline := '' ;
  271.               mask := '' ;
  272.               Get_Dedit ( dialog, mask_item, maskline ) ;
  273.               mask := maskline ;
  274.               doflag := true ;
  275.               main_opt := '' ;
  276.               second_opt := '' ;
  277.               if Obj_State ( dialog, add) & Selected <> 0 then
  278.                  main_opt := 'A' ;
  279.               if Obj_State ( dialog, extract) & Selected <> 0 then
  280.                  main_opt := 'X' ;
  281.               if Obj_State ( dialog, move) & Selected <> 0 then
  282.                  main_opt := 'M' ;
  283.               if Obj_State ( dialog, run) & Selected <> 0 then
  284.                  main_opt := 'R' ;
  285.               if Obj_State ( dialog, update) & Selected <> 0 then
  286.                  main_opt := 'U' ;
  287.               if Obj_State ( dialog, copy) & Selected <> 0 then
  288.                  main_opt := 'P' ;
  289.               if Obj_State ( dialog, freshen) & Selected <> 0 then
  290.                  main_opt := 'F' ;
  291.               if Obj_State ( dialog, list) & Selected <> 0 then
  292.                  main_opt := 'L' ;
  293.               if Obj_State ( dialog, delete) & Selected <> 0 then
  294.                  main_opt := 'D' ;
  295.               if Obj_State ( dialog, verbose) & Selected <> 0 then
  296.                  main_opt := 'V' ;
  297.               if Obj_State ( dialog, test) & Selected <> 0 then
  298.                  main_opt := 'T' ;
  299.               if Obj_State ( dialog, convert) & Selected <> 0 then
  300.                  main_opt := 'C' ;
  301.       { Secondary options IF's                                     }
  302.               if Obj_State ( dialog, hold) & Selected <> 0 then
  303.                  second_opt := concat( second_opt, 'H' ) ;
  304.               if Obj_State ( dialog, retain) & Selected <> 0 then
  305.                  second_opt := concat( second_opt, 'B' ) ;
  306.               if Obj_State ( dialog, suppr_comp) & Selected <> 0 then
  307.                  second_opt := concat( second_opt, 'S' ) ;
  308.               if Obj_State ( dialog, suppr_warn) & Selected <> 0 then
  309.                  second_opt := concat( second_opt, 'W' ) ;
  310.               if Obj_State ( dialog, suppr_not) & Selected <> 0 then
  311.                  second_opt := concat( second_opt, 'N' ) ;
  312.               if Obj_State ( dialog, encript) & Selected <> 0 then
  313.                  second_opt := concat( second_opt, 'G' ) ;
  314.                  encrline := '' ;
  315.                  Get_DEdit( dialog, encr_item, encrline ) ;
  316.                  second_opt := concat( second_opt, encrline ) ;
  317.               End_Dialog ( dialog ) ;
  318.            end ;
  319.         if Obj_State ( dialog, cancel_btn) & Selected <> 0 then
  320.            BEGIN
  321.               doflag := false ;
  322.               End_Dialog( dialog ) ;
  323.            END ;
  324.   END ; {makebox}
  325.  
  326.   BEGIN { main }
  327.     IF Init_Gem >= 0 THEN
  328.       BEGIN
  329.       set_mouse( m_arrow ) ;
  330.       find_rez ;
  331.  
  332.         repeat
  333.            make_box( flag, main_selection, sec_selection, search_mask ) ;
  334.            if flag = true then
  335.               begin
  336.                  get_pathname( path ) ;
  337.                  path := concat( path, '*.ARC' ) ;
  338.                  selection := True ;
  339.                  selection := Get_In_File( path, arc_name ) ;
  340.                  if selection = True then
  341.                     begin
  342.                        temp1 := concat('ARC.TTP ',main_selection ) ;
  343.                        temp2 := concat(sec_selection, ' ', arc_name ) ;
  344.                        temp3 := concat( ' ', search_mask ) ;
  345.                        tempname := concat( temp1, temp2, temp3 ) ;
  346.                        init_mouse ;
  347.                        hide_mouse ;
  348.                        clear_screen ;
  349.                        chain( tempname ) ;
  350.                        show_mouse ;
  351.                     end ;
  352.               end ;
  353.         until flag = false ;
  354.         Exit_Gem ;
  355.       END ;
  356.   END. { gem4arc1 }
  357.